home *** CD-ROM | disk | FTP | other *** search
/ Pascal Super Library / Pascal Super Library (CW International)(1997).bin / TURB_VIS / TVISION / FVIEWER.PAS < prev    next >
Pascal/Delphi Source File  |  1990-10-23  |  5KB  |  209 lines

  1. {************************************************}
  2. {                                                }
  3. {   Turbo Pascal 6.0                             }
  4. {   Turbo Vision Demo                            }
  5. {   Copyright (c) 1990 by Borland International  }
  6. {                                                }
  7. {************************************************}
  8.  
  9. unit FViewer;
  10.  
  11. {$F+,O+,X+,S-,D-}
  12.  
  13. { FileViewer object for scrolling through text files. See
  14.   TVDEMO.PAS for an example program that uses this unit.
  15. }
  16.  
  17. interface
  18.  
  19. uses Objects, Views, Dos;
  20.  
  21. type
  22.  
  23.   { TLineCollection }
  24.  
  25.   PLineCollection = ^TLineCollection;
  26.   TLineCollection = object(TCollection)
  27.     procedure FreeItem(P: Pointer); virtual;
  28.   end;
  29.  
  30.   { TFileViewer }
  31.  
  32.   PFileViewer = ^TFileViewer;
  33.   TFileViewer = object(TScroller)
  34.     FileName: PString;
  35.     FileLines: PCollection;
  36.     IsValid: Boolean;
  37.     constructor Init(var Bounds: TRect; AHScrollBar, AVScrollBar: PScrollBar;
  38.       var AFileName: PathStr);
  39.     constructor Load(var S: TStream);
  40.     destructor Done; virtual;
  41.     procedure Draw; virtual;
  42.     procedure ReadFile(var FName: PathStr);
  43.     procedure SetState(AState: Word; Enable: Boolean); virtual;
  44.     procedure Store(var S: TStream);
  45.     function Valid(Command: Word): Boolean; virtual;
  46.   end;
  47.  
  48.   { TFileWindow }
  49.  
  50.   PFileWindow = ^TFileWindow;
  51.   TFileWindow = object(TWindow)
  52.     constructor Init(var FileName: PathStr);
  53.   end;
  54.  
  55. const
  56.  
  57.   RFileViewer: TStreamRec = (
  58.      ObjType: 10080;
  59.      VmtLink: Ofs(TypeOf(TFileViewer)^);
  60.      Load:    @TFileViewer.Load;
  61.      Store:   @TFileViewer.Store
  62.   );
  63.   RFileWindow: TStreamRec = (
  64.      ObjType: 10081;
  65.      VmtLink: Ofs(TypeOf(TFileWindow)^);
  66.      Load:    @TFileWindow.Load;
  67.      Store:   @TFileWindow.Store
  68.   );
  69.  
  70. procedure RegisterFViewer;
  71.  
  72. implementation
  73.  
  74. uses Drivers, Memory, MsgBox, App;
  75.  
  76. { TLineCollection }
  77. procedure TLineCollection.FreeItem(P: Pointer);
  78. begin
  79.   DisposeStr(P);
  80. end;
  81.  
  82. { TFileViewer }
  83. constructor TFileViewer.Init(var Bounds: TRect; AHScrollBar,
  84.   AVScrollBar: PScrollBar; var AFileName: PathStr);
  85. begin
  86.   TScroller.Init(Bounds, AHScrollbar, AVScrollBar);
  87.   GrowMode := gfGrowHiX + gfGrowHiY;
  88.   FileName := nil;
  89.   ReadFile(AFileName);
  90. end;
  91.  
  92. constructor TFileViewer.Load(var S: TStream);
  93. var
  94.   FName: PathStr;
  95. begin
  96.   TScroller.Load(S);
  97.   FileName := S.ReadStr;
  98.   FName := FileName^;
  99.   ReadFile(FName);
  100. end;
  101.  
  102. destructor TFileViewer.Done;
  103. begin
  104.   Dispose(FileLines, Done);
  105.   TScroller.Done;
  106. end;
  107.  
  108. procedure TFileViewer.Draw;
  109. var
  110.   B: TDrawBuffer;
  111.   C: Byte;
  112.   I: Integer;
  113.   S: String;
  114.   P: PString;
  115. begin
  116.   C := GetColor(1);
  117.   for I := 0 to Size.Y - 1 do
  118.   begin
  119.     MoveChar(B, ' ', C, Size.X);
  120.     if Delta.Y + I < FileLines^.Count then
  121.     begin
  122.       P := FileLines^.At(Delta.Y + I);
  123.       if P <> nil then S := Copy(P^, Delta.X + 1, Size.X)
  124.       else S := '';
  125.       MoveStr(B, S, C);
  126.     end;
  127.     WriteLine(0, I, Size.X, 1, B);
  128.   end;
  129. end;
  130.  
  131. procedure TFileViewer.ReadFile(var FName: PathStr);
  132. var
  133.   FileToView: Text;
  134.   Line: String;
  135.   MaxWidth: Integer;
  136.   E: TEvent;
  137. begin
  138.   IsValid := True;
  139.   if FileName <> nil then DisposeStr(FileName);
  140.   FileName := NewStr(FName);
  141.   FileLines := New(PLineCollection, Init(5,5));
  142.   {$I-}
  143.   Assign(FileToView, FName);
  144.   Reset(FileToView);
  145.   if IOResult <> 0 then
  146.   begin
  147.     MessageBox('Cannot open file '+FName+'.', nil, mfError + mfOkButton);
  148.     IsValid := False;
  149.   end
  150.   else
  151.   begin
  152.     MaxWidth := 0;
  153.     while not Eof(FileToView) and not LowMemory do
  154.     begin
  155.       Readln(FileToView, Line);
  156.       if Length(Line) > MaxWidth then MaxWidth := Length(Line);
  157.       FileLines^.Insert(NewStr(Line));
  158.     end;
  159.     Close(FileToView);
  160.   end;
  161.   {$I+}
  162.   Limit.X := MaxWidth;
  163.   Limit.Y := FileLines^.Count;
  164. end;
  165.  
  166. procedure TFileViewer.SetState(AState: Word; Enable: Boolean);
  167. begin
  168.   TScroller.SetState(AState, Enable);
  169.   if Enable and (AState and sfExposed <> 0) then
  170.      SetLimit(Limit.X, Limit.Y);
  171. end;
  172.  
  173. procedure TFileViewer.Store(var S: TStream);
  174. begin
  175.   TScroller.Store(S);
  176.   S.WriteStr(FileName);
  177. end;
  178.  
  179. function TFileViewer.Valid(Command: Word): Boolean;
  180. begin
  181.   Valid := IsValid;
  182. end;
  183.  
  184. { TFileWindow }
  185. constructor TFileWindow.Init(var FileName: PathStr);
  186. const
  187.   WinNumber: Integer = 1;
  188. var
  189.   R: TRect;
  190. begin
  191.   Desktop^.GetExtent(R);
  192.   TWindow.Init(R, Filename, WinNumber);
  193.   Options := Options or ofTileable;
  194.   Inc(WinNumber);
  195.   GetExtent(R);
  196.   R.Grow(-1, -1);
  197.   Insert(New(PFileViewer, Init(R,
  198.     StandardScrollBar(sbHorizontal + sbHandleKeyboard),
  199.     StandardScrollBar(sbVertical + sbHandleKeyboard), Filename)));
  200. end;
  201.  
  202. procedure RegisterFViewer;
  203. begin
  204.   RegisterType(RFileViewer);
  205.   RegisterType(RFileWindow);
  206. end;
  207.  
  208. end.
  209.